
{***********************************************************}
{                                                           }
{      Luxena dbExpress eXtension Components                }
{                                                           }
{      DataSet implementation classes                       }
{                                                           }
{      Copyright (c) 2001-2006 Luxena Software Company      }
{      http://www.luxena.com                                }
{      e-mail: support@luxena.com                           }
{                                                           }
{***********************************************************}

unit DBXDataSetImpl;

{$I lx.inc}

interface

uses
  Classes, DB, SqlExpr, LXSQLProcessor, LXDataSetImpl, DBXSQLProcessor;


const

{ Property Default Values }

  DBX_DEFAULT_CLOSE_WITH_MASTER = False;


type

{ TDBXDataSetImpl }

  TDBXUpdateApplyEvent = procedure (DataSet: TDataSet; UpdateKind: TUpdateKind;
    Params: TParams) of object;

  IDBXDataSetExtension = interface
    ['{C66C9E12-55B1-47d4-AAEB-9E6B84EF4785}']
    procedure SetDesignActivation(Value: Boolean);
    function GetDesignActivation: Boolean;
    procedure SetPageSize(Value: Integer);
    function GetPageSize: Integer;
    procedure SetPacketRecords(const Value: Integer);
    function GetPacketRecords: Integer;
    procedure SetCloseWithMaster(Value: Boolean);
    function GetCloseWithMaster: Boolean;
    procedure SetUpdateObject(Value: TLXDataSetUpdateObject);
    function GetUpdateObject: TLXDataSetUpdateObject;
    procedure SetRefreshLocates(Value: Boolean);
    function GetRefreshLocates: Boolean;
    procedure SetRecordRefreshMode(Value: TLXRecordRefreshMode);
    function GetRecordRefreshMode: TLXRecordRefreshMode;
    procedure SetCachedUpdates(Value: Boolean);
    function GetCachedUpdates: Boolean;
    procedure SetAutoCommitUpdates(Value: Boolean);
    function GetAutoCommitUpdates: Boolean;
    procedure SetUpdateOptions(Value: TLXRecordUpdateOptions);
    function GetUpdateOptions: TLXRecordUpdateOptions;
    procedure SetUpdateMode(Value: TUpdateMode);
    function GetUpdateMode: TUpdateMode;
    function GetUpdatesPending: Boolean;
    procedure SetStatusFilter(Value: TUpdateStatusSet);
    function GetStatusFilter: TUpdateStatusSet;
    procedure SetBeforeApplyUpdates(Value: TDataSetNotifyEvent);
    function GetBeforeApplyUpdates: TDataSetNotifyEvent;
    procedure SetAfterApplyUpdates(Value: TDataSetNotifyEvent);
    function GetAfterApplyUpdates: TDataSetNotifyEvent;
    procedure SetOnUpdateRecord(Value: TUpdateRecordEvent);
    function GetOnUpdateRecord: TUpdateRecordEvent;
    procedure SetOnGetTableName(Value: TLXGetTableNameEvent);
    function GetOnGetTableName: TLXGetTableNameEvent;
    procedure SetOnUpdateApply(Value: TDBXUpdateApplyEvent);
    function GetOnUpdateApply: TDBXUpdateApplyEvent;
    procedure SetOnUpdateApplied(Value: TLXUpdateAppliedEvent);
    function GetOnUpdateApplied: TLXUpdateAppliedEvent;
    procedure SetOnUpdateError(Value: TUpdateErrorEvent);
    function GetOnUpdateError: TUpdateErrorEvent;
    procedure SetOnRefreshRecord(Value: TDBXUpdateApplyEvent);
    function GetOnRefreshRecord: TDBXUpdateApplyEvent;
    function GetVersion: string;
    function GetActiveSQLProcessor: TDBXSQLProcessor;

    procedure Prepare;
    procedure Unprepare;
    procedure FetchAll;
    procedure ApplyUpdates; overload;
    procedure ApplyUpdates(CommitUpdates: Boolean); overload;
    procedure CommitUpdates;
    procedure CancelUpdates;
    procedure RevertRecord;
    function LocateNext(const KeyFields: string; const KeyValues: Variant;
      Options: TLocateOptions): Boolean;
    procedure Requery;

    property DesignActivation: Boolean read GetDesignActivation write SetDesignActivation;
    property PageSize: Integer read GetPageSize write SetPageSize;
    property PacketRecords: Integer read GetPacketRecords write SetPacketRecords;
    property CloseWithMaster: Boolean read GetCloseWithMaster write SetCloseWithMaster;
    property UpdateObject: TLXDataSetUpdateObject read GetUpdateObject write SetUpdateObject;
    property RefreshLocates: Boolean read GetRefreshLocates write SetRefreshLocates;
    property RecordRefreshMode: TLXRecordRefreshMode read GetRecordRefreshMode write SetRecordRefreshMode;
    property UpdatesPending: Boolean read GetUpdatesPending;
    property CachedUpdates: Boolean read GetCachedUpdates write SetCachedUpdates;
    property AutoCommitUpdates: Boolean read GetAutoCommitUpdates write SetAutoCommitUpdates;
    property UpdateOptions: TLXRecordUpdateOptions read GetUpdateOptions write SetUpdateOptions;
    property UpdateMode: TUpdateMode read GetUpdateMode write SetUpdateMode;
    property StatusFilter: TUpdateStatusSet read GetStatusFilter write SetStatusFilter;
    property BeforeApplyUpdates: TDataSetNotifyEvent read GetBeforeApplyUpdates write SetBeforeApplyUpdates;
    property AfterApplyUpdates: TDataSetNotifyEvent read GetAfterApplyUpdates write SetAfterApplyUpdates;
    property OnUpdateRecord: TUpdateRecordEvent read GetOnUpdateRecord write SetOnUpdateRecord;
    property OnGetTableName: TLXGetTableNameEvent read GetOnGetTableName write SetOnGetTableName;
    property OnUpdateApply: TDBXUpdateApplyEvent read GetOnUpdateApply write SetOnUpdateApply;
    property OnUpdateApplied: TLXUpdateAppliedEvent read GetOnUpdateApplied write SetOnUpdateApplied;
    property OnUpdateError: TUpdateErrorEvent read GetOnUpdateError write SetOnUpdateError;
    property OnRefreshRecord: TDBXUpdateApplyEvent read GetOnRefreshRecord write SetOnRefreshRecord;
    property Version: string read GetVersion;
    property ActiveSQLProcessor: TDBXSQLProcessor read GetActiveSQLProcessor;
  end;

  IDBXDataSetSupport = interface(ILXDataSetSupport)
    ['{327F0455-D7FA-45BC-9BD2-1EA4358FB2CA}']
    function GetActiveSQLProcessor: TDBXSQLProcessor;
    function GetMacros: TStrings;
  end;

  TDBXDataSetImpl = class(TLXDataSetImpl, ILXUpdateSQLSupport)
  private
    FCloseWithMaster: Boolean;
    FOnUpdateApply: TDBXUpdateApplyEvent;
    FOnRefreshRecord: TDBXUpdateApplyEvent;
    procedure AssignParams(Params: TParams; Delta: TDataSet);
    function GetSQLProcessor: TDBXSQLProcessor;
    function GetMacros: TStrings;
    function ProcessRecord(Delta: TDataSet; UpdateKind: TUpdateKind; const SQL: string;
      ProcessEvent: TDBXUpdateApplyEvent; NewData: Pointer): Integer;

  protected
    { ILXUpdateSQLSupport }
    function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
    function _AddRef: Integer; stdcall;
    function _Release: Integer; stdcall;
    function CreateSQLGenerator(Delta: TDataSet): TLXSQLGenerator;
    function ModifyRecord(Delta: TDataSet; UpdateKind: TUpdateKind; const SQL: string) : Integer;
    procedure RefreshRecord(Delta: TDataSet; UpdateKind: TUpdateKind; const SQL: string);

  public
    constructor Create(DataSet: TCustomSQLDataSet; const DataSetSupport: IDBXDataSetSupport);
    class procedure SetEof(DataSet: TDataSet; Value: Boolean);
    property CloseWithMaster: Boolean read FCloseWithMaster write FCloseWithMaster;
    property OnUpdateApply: TDBXUpdateApplyEvent read FOnUpdateApply write FOnUpdateApply;
    property OnRefreshRecord: TDBXUpdateApplyEvent read FOnRefreshRecord write FOnRefreshRecord;
  end;


implementation

uses SysUtils, LXVariants, LXMacroSQL, DBXConsts;


{ TDBXDataLink }

type
  TCustomSQLDataSetChild = class(TCustomSQLDataSet);

  TDBXDataLink = class(TSQLDataLink)
  protected
    procedure RecordChanged(Field: TField); override;
  end;

procedure TDBXDataLink.RecordChanged(Field: TField);

  function IsMasterChanged: Boolean;
  var
    Params: TParams;
    I: Integer;
    Field: TField;
    Param: TParam;
  begin
    Params := TCustomSQLDataSetChild(DetailDataSet).Params;

    for I := 0 to Params.Count - 1 do
    begin
      Param := Params[I];
      Field := DataSet.FindField(Param.Name);
      if (Field <> nil) and (Param.Value <> Field.Value) then
      begin
        Result := True;
        Exit;
      end;
    end;

    Result := False;
  end;

begin
  if (Field = nil) and DetailDataSet.Active and
    (DataSource.State <> dsSetKey) and IsMasterChanged then
  begin
    if Active then
      TCustomSQLDataSetChild(DetailDataSet).SetParamsFromCursor;
    (DetailDataSet as IDBXDataSetExtension).Requery;
  end;
end;


{ TDBXDataSetImpl }

{$HINTS OFF}
type
{$IFDEF D10}
  TCustomSQLDataSetFake = class(TWideDataSet)
{$ELSE}
  TCustomSQLDataSetFake = class(TDataSet)
{$ENDIF}
  private
    FBlobBuffer: TBlobByteData;
    FCalcFieldsBuffer: PChar;
    FCheckRowsAffected: Boolean;
    FClonedConnection: TSqlConnection;
{$IFDEF D10}
    FCommandText: WideString;
{$ELSE}
    FCommandText: string;
{$ENDIF}
    FCommandType: TSQLCommandType;
    FCurrentBlobSize: LongWord;
    FDataLink: TDataLink;
  end;
{$HINTS ON}

constructor TDBXDataSetImpl.Create(DataSet: TCustomSQLDataSet;
  const DataSetSupport: IDBXDataSetSupport);
begin
  inherited Create(DataSet, DataSetSupport, Self);
  TCustomSQLDataSetFake(DataSet).FDataLink.Free;
  TCustomSQLDataSetFake(DataSet).FDataLink := TDBXDataLink.Create(DataSet);
  FCloseWithMaster := DBX_DEFAULT_CLOSE_WITH_MASTER;
end;

function TDBXDataSetImpl.QueryInterface(const IID: TGUID;
  out Obj): HResult;
const
  E_NOINTERFACE = HResult($80004002);
begin
  if GetInterface(IID, Obj) then Result := 0 else Result := E_NOINTERFACE;
end;

function TDBXDataSetImpl._AddRef: Integer;
begin
  Result := -1;
end;

function TDBXDataSetImpl._Release: Integer;
begin
  Result := -1;
end;

procedure TDBXDataSetImpl.AssignParams(Params: TParams; Delta: TDataSet);
var
  Param: TParam;
  FieldName: string;
  Field: TField;
  IsOld: Boolean;
  I: Integer;
  StateContext: TLXDataSetStateContext;
begin
  for I := 0 to Params.Count - 1 do
  begin
    Param := Params[I];
    if Param.Bound then Continue;

    FieldName := Param.Name;

    IsOld := StrLComp(PChar(FieldName), 'OLD_', 4) = 0;
    if IsOld then System.Delete(FieldName, 1, 4);

    Field := Delta.FindField(FieldName);
    if Field = nil then Continue;

    if IsOld or LXVarIsClear(Field.NewValue) then
      StateContext := SetDataSetState(Delta, dsOldValue) else
      StateContext := SetDataSetState(Delta, dsNewValue);
    try
      Param.AssignFieldValue(Field, Field.Value);
    finally
      RestoreDataSetState(Delta, StateContext);
    end;
  end;
end;

function TDBXDataSetImpl.GetSQLProcessor: TDBXSQLProcessor;
begin
  Result := IDBXDataSetSupport(DataSetSupport).GetActiveSQLProcessor;
end;

function TDBXDataSetImpl.GetMacros: TStrings;
begin
  Result := IDBXDataSetSupport(DataSetSupport).GetMacros;
end;

function TDBXDataSetImpl.CreateSQLGenerator(Delta: TDataSet): TLXSQLGenerator;
begin
  Result := GetSQLProcessor.CreateSQLGenerator(
    True, IProviderSupport(DataSet).PSGetQuoteChar, GetTableName, Delta.Fields);
  Result.UpdateMode := UpdateMode;
end;

function TDBXDataSetImpl.ProcessRecord(Delta: TDataSet; UpdateKind: TUpdateKind;
  const SQL: string; ProcessEvent: TDBXUpdateApplyEvent; NewData: Pointer): Integer;
var
  MacroSQLResult: ILXMacroSQLResult;
  Params: TParams;

  procedure FillParams(Params: TParams; ParamNames: TStrings);
  var
    I: Integer;
  begin
    for I := 0 to ParamNames.Count - 1 do
      Params.CreateParam(ftUnknown, ParamNames[I], ptInput);
  end;

begin
  MacroSQLResult := GetSQLProcessor.ParseAndBuild(SQL, GetMacros);
  Params := TParams.Create;
  try
    FillParams(Params, MacroSQLResult.ParamNames);
    if Assigned(ProcessEvent) then
      ProcessEvent(Delta, UpdateKind, Params);
    AssignParams(Params, Delta);
    Result := IProviderSupport(DataSet).PSExecuteStatement(MacroSQLResult.SQL,
      Params, NewData);
  finally
    Params.Free;
  end;
end;

function TDBXDataSetImpl.ModifyRecord(Delta: TDataSet;
  UpdateKind: TUpdateKind; const SQL: string): Integer;
begin
  Result := ProcessRecord(Delta, UpdateKind, SQL, FOnUpdateApply, nil);
end;

procedure TDBXDataSetImpl.RefreshRecord(Delta: TDataSet;
  UpdateKind: TUpdateKind; const SQL: string);
var
  StateContext: TLXDataSetStateContext;
  I: Integer;
  SourceField: TField;
  DestField: TField;
  NewData: TDataSet;
begin
  NewData := nil;
  try
    ProcessRecord(Delta, UpdateKind, SQL, FOnRefreshRecord, @NewData);
    if not NewData.Eof then
    begin
      StateContext := SetDataSetState(Delta, dsNewValue);
      try
        for I := 0 to NewData.FieldCount - 1 do
        begin
          SourceField := NewData.Fields[I];
          DestField := Delta.FindField(SourceField.FieldName);
          if DestField <> nil then
            DestField.Assign(SourceField);
        end;
      finally
        RestoreDataSetState(Delta, StateContext);
      end;
      NewData.Next;
      if not NewData.Eof then
        DatabaseError(SInvalidRefreshResults, DataSet);
    end;
  except
    on E: Exception do
    begin
      NewData.Free;
      E.Message := SCannotRefreshRecord + SLineBreak + E.Message;
      raise;
    end;
  end;
  NewData.Free;
end;

{$HINTS OFF}
type
  TDataSetFake = class(TComponent)
  private
    FFields: TFields;
    FAggFields: TFields;
    FFieldDefs: TFieldDefs;
    FFieldDefList: TFieldDefList;
    FFieldList: TFieldList;
    FDataSources: TList;
    FFirstDataLink: TDataLink;
    FBufferCount: Integer;
    FRecordCount: Integer;
    FActiveRecord: Integer;
    FCurrentRecord: Integer;
    FBuffers: TBufferList;
    FCalcBuffer: PChar;
    FBookmarkSize: Integer;
    FCalcFieldsSize: Integer;
    FDesigner: TDataSetDesigner;
    FDisableCount: Integer;
    FBlobFieldCount: Integer;
    FFilterText: string;
    FBlockReadSize: Integer;
    FConstraints: TCheckConstraints;
    FDataSetField: TDataSetField;
    FIsUniDirectional: Boolean;
    FNestedDataSets: TList;
    FNestedDatasetClass: TClass;
    FReserved: Pointer;
    FFieldNoOfs: Integer;
    { Byte sized data members (for alignment) }
    FFilterOptions: TFilterOptions;
    FState: TDataSetState;
    FEnableEvent: TDataEvent;
    FDisableState: TDataSetState;
    FBOF: Boolean;
    FEOF: Boolean;
  end;
{$HINTS ON}

class procedure TDBXDataSetImpl.SetEof(DataSet: TDataSet; Value: Boolean);
begin
  TDataSetFake(DataSet).FEOF := Value;
end;


end.
